Pascal Super Library/Pascal Super Library (CW International)(1997).bin/LIBRARY/PBLIB1/PROGS/ENV.SAV

Text File | 1993-11-30 | 6KB | 260 lines

(*PAGE*)
PROGRAM ENV;

{$M 10000,0,10000}

{
Description :  Prints envelopes on LJ4

Author      : Howard Richoux
Date        : 11/20/93
Last revised: 11/30/93  more config parameters
Application : IBM PC and compatibles, done in Turbo Pascal 5.0
Status      : PUBLIC DOMAIN
Published in: none
}


Uses
     DOS, crtstuf,
     iostuf, miscstuf, fileobj, parmstuf, strastuf,
     slctstuf, helpstuf, ljiistuf;

var S            : string;
var outfile      : string[40];
    fname        : string[40];
    SetupString  : string[40];
    Ret1, Ret2, Ret3, Ret4   : string[40];
    ReturnFlag   : boolean;
    AddressPAD   : integer;
    setup1, setup2, setup3 : string;

var addressdir,template   : string[40];


{*****************************************************************}



Procedure ListFile(fname : string);
var line, CurrFName : string;
    done : boolean;
    tx   : TFILE_object;
    begin
    done := false;
    CurrFName := UpCaseStr(fname);
    tx.init(CurrFName,false);
    while tx.fetchnext(line) and not done do
        begin
        writeln(f,Conststr(' ',AddressPad),line);
        if keypressed then done := true;
        end;
    tx.done;
    end;


Function LocateFile(var fn : string) : boolean;
var i :integer;
    found : boolean;
    begin
    found := true;
    if      FileExists(addressdir+fn + '.adr') then
         fn := addressdir+fn + '.adr'
    else if FileExists(addressdir+fn)          then
         begin end
    else found := false;
    LocateFile := found;
    end;


Procedure Shutdown;
    begin
    SetupString := chr(27) + 'E';
    write(f,SetupString);
    end;


Procedure EnvelopeSetUp;
    begin
    writeln('setup1 [',setup1,']');
    writeln('setup2 [',setup2,']');
    writeln('setup3 [',setup3,']');
    write(f,LJIICMD(3));  {Landscape Mode}
    write(f,LJIICMD(8));  {Manual Feed}
    write(f,LJIICMD(9));  {Legal Envelope size}
    writeln(f,'');
    if setup1 <> '' then write(f,#27+setup1);
    if setup2 <> '' then write(f,#27+setup2);

    if returnflag then
         begin
         writeln(f,'       ',Ret1);
         writeln(f,'       ',Ret2);
         writeln(f,'       ',Ret3);
         writeln(f,'       ',Ret4);
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         end
    else begin
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         writeln(f,'');
         end;
    if setup3 <> '' then write(f,#27+setup3);
    end;



Procedure PrintAddress(fn : string);
var SR :searchrec;
    i  : integer;
    fname : string[80];
    begin
    fname := fn;
    i := Pos('.',fname);
    if LocateFile(fname) then
         begin
         EnvelopeSetUp;
         ListFile(fname);
         end
    else writeln('PrintAddress - File Not Found - [',fname,']');
    Shutdown;
    end;


(*PAGE*)

Procedure Getfiles( Template : string; var fl : STRA_object);
var SR : searchrec;
    ok : boolean;
     begin
     FindFirst(Template,0,SR);
     while DOSError = 0 do
          begin
          if length(sr.name) > 4 then
              begin
              ok := fl.append(sr.name);
              end;
          FindNext(SR);
          end;
     fl.sort;
     end;


Procedure DoView(dir,template : string);
var filename   : string[40];
    cmd        : string[40];
    itemselect : integer;
var files      : STRA_object;
     begin
     itemselect := 1;
     HelpMaxLines := 1000;
     filename   := '';
     cmd        := '?RESELECT';
     files.init(100);
     Getfiles(addressdir+Template, files);
     while itemselect > 0 do
          begin
          SetSelectwindow(3,3,15,3,15);
          SetSelectWindowLabels(' ENV - Envelope Printer ',' Select a File ');
          SelectWCmd(files,filename,itemselect,cmd);
          if (filename <> '') then
              begin
              EnvelopeSetUp;
              ListFile(addressdir+filename);
              Shutdown;
             {itemselect := 0;}
              end;
          end;
     files.dispose;
     end;



(*PAGE*)


Procedure DoStatus;
    begin
    ListParms(0);
    end;


Procedure Init;
    begin
    AddParm(1,'PATH','c:\address\');
    template := '*.adr';
    addparm(1,'OUT','');
    addparm(1,'ADDRESSPAD','100');

    StandardpVarsInit;

    addressdir := GetParmStr('PATH');
    addresspad := GetParmNum('ADDRESSPAD');

    setup1 := '';
    setup2 := '';
    setup3 := '';
    setup1 := GetParmStr('SETUP1');
    setup2 := GetParmStr('SETUP2');
    setup3 := GetParmStr('SETUP3');


    Ret1 := 'Ret1';
    Ret2 := 'Ret2';
    Ret3 := 'Ret3';
    Ret4 := 'Ret4';
    Outfile    := GetParmStr('OUT');
    Ret1       := GetParmStr('RET1');
    Ret2       := GetParmStr('RET2');
    Ret3       := GetParmStr('RET3');
    Ret4       := GetParmStr('RET4');
    fIsPrinter := CheckOK('PRINTER');
    ReturnFlag := CheckOK('RETURN');

    if outfile <> '' then
        begin
        fReWrite(outfile,true);
        end;
    end;


(*  Main program *)
    BEGIN
    writeln('ENV 1.00 - Addresses Envelopes on LJ4   11/93');
    writeln(' Placed in public domain by Howard Richoux [phone]');
    writeln('');
    Init;

    fname := 'x';
    if ParamCount > 0 then
         begin
         fname := UpCaseStr(paramstr(1));
         if      fname = 'HELP'   then ShowDocFile
         else if fname = 'STATUS' then DoStatus
         else
              begin
              PrintAddress(fname);
              end;
         end
    else
         begin
         if template <> '' then DoView(addressdir,template)
         else writeln('template = ',template,'   dir = ',addressdir);
         end;
    writeln('');
    fIsPrinter := false;  {already have trailing FF}
    fcloseOutput;
    end.